home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbasicpg.zip / METEOR-2.BAS < prev    next >
BASIC Source File  |  1980-01-01  |  5KB  |  109 lines
  1.  
  2. 100 ' METEOR -- a character graphics arcade game for the IBM PC
  3. 110 ' by Edward T, Ordman  November 1981
  4. 111 ' The original version was published in the August, 1982 CREATIVE COMPUTING
  5. 112 '
  6. 115 ' This version modified by Andrew Fluegelman and Nancy Miller  July, 1982
  7. 116 ' (Original line numbering preserved for reference)
  8. 117 '
  9. 118 DEFINT A-Z:CLS:KEY OFF
  10. 120 M$=CHR$(2):C$=CHR$(219):X$=CHR$(25) ' face, solid, square, down arrow
  11. 130 C5$=C$+C$+C$+C$+C$:H$="":T=0 ' block, latch for face motion, score
  12. 140 Y=177:E2$=STRING$(2,Y):E5$=STRING$(5,Y):E6$=STRING$(6,Y) ' shading
  13. 142 IF STATE=2 THEN 180' skips title display if respond 'Y' to 'play again?'
  14. 144 HY=20:HX=50:C=-2:GOSUB 840
  15. 146 GOSUB 1200
  16. 148 IF STATE=1 THEN 180 ' skips directions prompt
  17. 150 LOCATE 1,1:PRINT"Do you want directions (y/n)?"
  18. 160 Q$=INKEY$:IF Q$="" THEN 160
  19. 170 IF Q$="Y" OR Q$="y" THEN GOSUB 930
  20. 180 ' start game
  21. 190 C=-2 ' base value for difficulty flag (incremented at 850)
  22. 220 R=VAL(RIGHT$(TIME$,2)):RANDOMIZE R ' seed
  23. 230 HX=20+INT(40*RND+1):HY=16+INT(8*RND+1) ' position for face
  24. 260 CLS:GOSUB 840 ' put targets, player marker
  25. 280 Y1=1:Y2=24 ' describe meteor path
  26. 290 X1=INT(RND*80+1):X2=INT(RND*80+1):GOSUB 400:GOTO 290
  27. 330 ' plot x$ at y,x checking for scores, face motion
  28. 340 K$=INKEY$:IF K$<>"" THEN H$=K$
  29. 350 IF LEN(H$)>0 THEN GOSUB 590
  30. 360 IF ABS(X-HX)<3 AND ABS(Y-HY)<2 THEN 450
  31. 370 IF SCREEN(Y,X)=219 THEN C2=-5:SOUND 660,1:GOSUB 740
  32. 375 IF Y=24 AND X=80 THEN X=79
  33. 380 LOCATE Y,X:PRINT X$;:SOUND (300-10*Y),1:RETURN
  34. 390 ' draw a line from x1,y1 to x2,y2
  35. 400 S0!=(X2-X1)/(Y2-Y1):S!=X1-S0!:FOR Y=Y1 TO Y2:S!=S!+S0!:X=INT(.5+S!):GOSUB 340:NEXT:RETURN
  36. 450 ' target is hit, position message
  37. 460 HX=HX-4:IF HX>72 THEN HX=72
  38. 470 IF HX<1 THEN HX=1
  39. 480 IF HY=24 THEN HY=23
  40. 490 IF HY=1 THEN HY=2
  41. 500 SOUND 400,8:LOCATE HY-1,HX+1:PRINT E6$:LOCATE HY,HX:PRINT E2$+"BANG"+E2$;:LOCATE HY+1,HX+1:PRINT E6$;
  42. 520 LOCATE 25,26:COLOR 23,0:PRINT SPACE$(37);"Play again (y/n)?";:COLOR 7,0
  43. 530 H$=INKEY$:IF H$="" THEN 530
  44. 540 IF H$="y" THEN CLEAR:DEFINT A-Z:STATE=1:CLS:GOTO 120
  45. 550 IF H$="Y" THEN CLEAR:DEFINT A-Z:STATE=2:CLS:GOTO 120
  46. 560 IF H$="N" OR H$="n" THEN LOCATE 25,26:PRINT"OK. Hope you had fun.";SPACE$(33);:FOR I=1 TO 3000:NEXT I:CLS:END
  47. 565 GOTO 530
  48. 570 ' process keyboard request
  49. 590 IF LEN(H$)=1 THEN H$="":RETURN
  50. 600 HH=ASC(RIGHT$(H$,1)):K$=H$:H$="":LOCATE HY,HX:PRINT" ";
  51. 630 IF HH=77 THEN HX=HX+1:H$=K$:IF HX>80 THEN HX=1
  52. 650 IF HH=75 THEN HX=HX-1:H$=K$:IF HX<1 THEN HX=80
  53. 670 IF HH=80 AND HY<24 THEN HY=HY+1:H$=K$
  54. 680 IF HH=72 AND HY>1 THEN HY=HY-1:H$=K$
  55. 690 IF HX=80 AND HY=24 THEN HY=23
  56. 700 IF SCREEN(HY,HX)=219 THEN SOUND 440,1:C2=10:GOSUB 740
  57. 710 IF SCREEN(HY,HX)=25 THEN SOUND 420,1:C2=2:GOSUB 740
  58. 720 LOCATE HY,HX:PRINT M$;:RETURN
  59. 740 T=T+C2:LOCATE 25,19:COLOR 15,0:PRINT (1000*T1+T);:COLOR 7,0 ' score points
  60. 750 IF T>999 THEN T1=T1+1:T=T-1000:SOUND 2000,4:GOSUB 840
  61. 760 RETURN
  62. 840 ' put targets and face on screen
  63. 850 C=C+3:IF C>9 THEN C=1
  64. 860 FOR I=12-C TO 24-C
  65. 870 LOCATE I,15:PRINT C5$;:LOCATE I,35:PRINT C5$;:LOCATE I,55:PRINT C5$;
  66. 900 NEXT I:LOCATE HY,HX:PRINT M$;
  67. 910 LOCATE 25,1:COLOR 15,0:PRINT"METEOR!";:COLOR 7,0:PRINT"   score:               (the ";C$;"s will reset every 1000 points.)         ";
  68. 920 RETURN
  69. 930 ' directions
  70. 940 CLS:PRINT:COLOR 15,0:PRINT TAB(28)"METEOR!":COLOR 7,0:PRINT:PRINT
  71. 950 PRINT:PRINT"Erase the ";C$;"s before a falling ";X$;" hits you.
  72. 955 PRINT
  73. 960 PRINT"The cursor control keys starts ";M$;" moving."
  74. 965 PRINT"The other keypad keys stop ";M$;"."
  75. 1000 PRINT:PRINT"Each ";C$;" erased scores 10 points -- each "X$;" erased scores 2 points.
  76. 1010 PRINT"You lose 2 points for each "C$;" a ";X$;" hits.
  77. 1020 PRINT:PRINT"You will be hit if a ";X$;" strikes within the shaded area:
  78. 1030 PRINT:PRINT TAB(37);E5$:PRINT TAB(37);E2$+M$+E2$
  79. 1050 PRINT TAB(37);E5$:PRINT:PRINT
  80. 1060 PRINT"Your score for the game will appear on the bottom line."
  81. 1065 PRINT"Good luck!"
  82. 1070 PRINT:PRINT "Hit any key to proceed...";
  83. 1080 Z$=INKEY$:IF Z$="" THEN 1080
  84. 1090 RETURN
  85. 1200 'print startup display
  86. 1205 YS=1 'variable for sound
  87. 1210 READ Y,X
  88. 1215 IF Y=99 THEN RESTORE:SOUND 400,8:LOCATE 7,63:PRINT E6$:LOCATE 8,62:PRINT E2$+"BANG"+E2$;:LOCATE 9,63:PRINT E6$;:FOR I=1 TO 1000:NEXT I:RETURN
  89. 1220 LOCATE Y,X:PRINT X$;:SOUND (300-10*YS),1:YS=YS+1:IF YS=25 THEN YS=1
  90. 1230 GOTO 1210
  91. 1300 DATA 3,14,3,15,4,14,4,15,5,14,4,16,5,15,6,14,4,17,6,15,7,14
  92. 1310 DATA 5,17,7,15,8,14,4,19,5,18,8,15,3,21,4,20,5,19,6,18,3,22
  93. 1320 DATA 4,21,4,22,5,21,5,22,6,21,3,25,6,22,7,21,3,26,4,25,7,22
  94. 1330 DATA 8,21,3,27,4,26,5,25,8,22,3,28,5,26,6,25,3,29,5,27,6,26
  95. 1340 DATA 7,25,3,30,5,28,7,26,8,25,8,26,3,32,8,27,3,33,8,28,3,34
  96. 1350 DATA 8,29,3,35,8,30,3,36,4,35,3,37,4,36,5,35,3,38,5,36,6,35
  97. 1360 DATA 3,39,6,36,7,35,7,36,8,35,3,41,8,36,3,42,4,41,3,43,4,42
  98. 1370 DATA 5,41,3,44,5,42,6,41,3,45,5,43,6,42,7,41,3,46,5,44,7,42
  99. 1380 DATA 8,41,8,42,8,43,3,49,4,48,8,44,3,50,4,49,5,48,8,45,3,51
  100. 1390 DATA 5,49,6,48,8,46,3,52,6,49,7,48,4,52,7,49,4,53,5,52,8,49
  101. 1400 DATA 5,53,6,52,8,50,3,56,6,53,7,52,8,51,3,57,4,56,7,53,8,52
  102. 1410 DATA 3,58,4,57,5,56,3,59,5,57,6,56,3,60,5,58,6,57,7,56,3,61
  103. 1420 DATA 5,59,7,57,8,56,4,61,5,60,6,59,8,57,4,62,5,61,6,60,7,60
  104. 1430 DATA 3,65,7,61,3,66,4,65,8,61,4,66,5,65,8,62,5,66,6,65,6,66
  105. 1440 DATA 8,65,8,66,99,99
  106.  
  107.  
  108. 9,8,57,4,62,5,61,6,60,7,60
  109. 1430 DATA 3,